home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH8 / SRC / SIERP2.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-07  |  4.1 KB  |  140 lines
  1. VERSION 4.00
  2. Begin VB.Form Sierp2Form 
  3.    Caption         =   "Sierpinski Gasket"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   1185
  7.    ClientWidth     =   5400
  8.    Height          =   5025
  9.    Left            =   2220
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   289
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   360
  14.    Top             =   555
  15.    Width           =   5520
  16.    Begin VB.TextBox LevelText 
  17.       Height          =   285
  18.       Left            =   600
  19.       MaxLength       =   3
  20.       TabIndex        =   0
  21.       Text            =   "5"
  22.       Top             =   0
  23.       Width           =   375
  24.    End
  25.    Begin VB.PictureBox Canvas 
  26.       AutoRedraw      =   -1  'True
  27.       FillStyle       =   0  'Solid
  28.       Height          =   4335
  29.       Left            =   1080
  30.       ScaleHeight     =   285
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   277
  33.       TabIndex        =   3
  34.       Top             =   0
  35.       Width           =   4215
  36.    End
  37.    Begin VB.CommandButton CmdGo 
  38.       Caption         =   "Go"
  39.       Default         =   -1  'True
  40.       Height          =   495
  41.       Left            =   120
  42.       TabIndex        =   1
  43.       Top             =   480
  44.       Width           =   735
  45.    End
  46.    Begin VB.Label Label1 
  47.       Caption         =   "Level"
  48.       Height          =   255
  49.       Index           =   0
  50.       Left            =   0
  51.       TabIndex        =   2
  52.       Top             =   0
  53.       Width           =   495
  54.    End
  55.    Begin VB.Menu mnuFile 
  56.       Caption         =   "&File"
  57.       Begin VB.Menu mnuFileExit 
  58.          Caption         =   "E&xit"
  59.       End
  60.    End
  61. Attribute VB_Name = "Sierp2Form"
  62. Attribute VB_Creatable = False
  63. Attribute VB_Exposed = False
  64. Option Explicit
  65. Dim TheLevel As Integer
  66. Dim StartX(1 To 3) As Single
  67. Dim StartY(1 To 3) As Single
  68. ' ************************************************
  69. ' Draw a Sierpinski gasket.
  70. ' ************************************************
  71. Sub SierpGasket(level As Integer, x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single)
  72. Dim newy As Single
  73. Dim newx1 As Single
  74. Dim newx2 As Single
  75. Dim newx3 As Single
  76. Dim pt(1 To 3) As POINTAPI
  77. Dim status As Long
  78.     ' Draw a filled in polygon.
  79.     Canvas.FillColor = vbBlack
  80.     pt(1).x = x1
  81.     pt(1).y = y1
  82.     pt(2).x = x2
  83.     pt(2).y = y2
  84.     pt(3).x = x3
  85.     pt(3).y = y3
  86.     status = Polygon(Canvas.hdc, pt(1), 3)
  87.             
  88.     ' If this is a level 0 gasket, we're done.
  89.     If level < 1 Then Exit Sub
  90.         
  91.     ' Find the corners of the sub-triangles.
  92.     newy = (y1 + y2) / 2
  93.     newx1 = (3 * x1 + x3) / 4
  94.     newx2 = (x1 + x3) / 2
  95.     newx3 = (x1 + 3 * x3) / 4
  96.     ' Erase the middle triangle.
  97.     Canvas.FillColor = Canvas.BackColor
  98.     pt(1).x = newx1
  99.     pt(1).y = newy
  100.     pt(2).x = newx3
  101.     pt(2).y = newy
  102.     pt(3).x = newx2
  103.     pt(3).y = y1
  104.     status = Polygon(Canvas.hdc, pt(1), 3)
  105.     ' Recursively make the other gaskets.
  106.     SierpGasket level - 1, x1, y1, newx1, newy, newx2, y1
  107.     SierpGasket level - 1, newx1, newy, newx2, y2, newx3, newy
  108.     SierpGasket level - 1, newx2, y1, newx3, newy, x3, y1
  109. End Sub
  110. Sub GetParameters()
  111.     If Not IsNumeric(LevelText.Text) Then _
  112.         LevelText.Text = "5"
  113.     TheLevel = CInt(LevelText.Text)
  114. End Sub
  115. Private Sub CmdGo_Click()
  116. Dim i As Integer
  117.     MousePointer = vbHourglass
  118.     DoEvents
  119.     ' Get the parameters.
  120.     GetParameters
  121.     ' Draw the curve.
  122.     Canvas.Cls
  123.     SierpGasket TheLevel, StartX(1), StartY(1), StartX(2), StartY(2), StartX(3), StartY(3)
  124.     MousePointer = vbDefault
  125. End Sub
  126. Private Sub Form_Resize()
  127.     Canvas.Move Canvas.Left, 0, _
  128.         ScaleWidth - Canvas.Left, ScaleHeight - 1
  129.     ' See where the first corners should be.
  130.     StartX(1) = Canvas.ScaleWidth * 0.05
  131.     StartX(2) = Canvas.ScaleWidth * 0.5
  132.     StartX(3) = Canvas.ScaleWidth * 0.95
  133.     StartY(1) = Canvas.ScaleHeight * 0.95
  134.     StartY(2) = Canvas.ScaleHeight * 0.05
  135.     StartY(3) = StartY(1)
  136. End Sub
  137. Private Sub mnuFileExit_Click()
  138.     Unload Me
  139. End Sub
  140.